home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mtfonts.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  18.3 KB  |  568 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtFonts;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *  3.01     | 02.02.92 |  Hp  | Freigabe der FSM-Version. Die Non-FSM  *
  29.  *           |          |      | wird hiermit nicht mehr vertrieben!    *
  30.  *-----------+----------+------+----------------------------------------*)
  31.  
  32.  
  33.  
  34. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  35. (*                                              *)
  36. (*$R-   Range-Checks                            *)
  37. (*$S-   Stack-Check                             *)
  38. (*                                              *)
  39. (*----------------------------------------------*)
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  47.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  48.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  49.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  50.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  51.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  52.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  53.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  63.  
  64.  
  65.  
  66.  
  67. FROM SYSTEM             IMPORT  ADDRESS, ADR, BYTE, TSIZE;
  68. FROM MagicStrings       IMPORT  Append, Assign, Length;
  69. FROM MagicConvert       IMPORT  IntToStr;
  70. FROM mtAppl             IMPORT  VqGdos, VDIHandle, CharHeight, CharWidth;
  71. FROM MagicAES           IMPORT  SELECTED, OUTLINED, TOUCHEXIT, HIDETREE,
  72.                                 SELECTABLE, Exit, DEFAULT, DISABLED;
  73. FROM MagicFSM           IMPORT  FSMGdos, FontGdos, NoError, CharNotFound,
  74.                                 ReadError, OpenError, BadFileformat, 
  75.                                 OutOfMemory, MiscError, FsmInt, FsmFpoint,
  76.                                 FsmDataFpoint, PtrFsmComponent, FsmComponent,
  77.                                 InqFacename, InqFExtent, FSMText, KillOutline,
  78.                                 GetOutline, ScratchFSM, ScratchBitmap, NoScratch,
  79.                                 SetScratch, ToApplication, ToScreen, SetErrormode,
  80.                                 SetArbpoints, InqAdvance, InqDeviceinfo, 
  81.                                 SaveFSMCache, LoadFSMCache, FlushFSMCache, 
  82.                                 SetSize, SetSkew, GetFSMAsciitable, GetFSMCachesize,
  83.                                 EnableBezier, DisableBezier, BezierBuffer, 
  84.                                 Bezier, FilledBezier, BezierQuality;
  85.  
  86. IMPORT  MagicTypes, MagicAES, MagicVDI, MagicDOS, MagicBIOS,
  87.         MagicSys, mtAppl, mtUtils;
  88.  
  89. (*----------------------------------------------------------------------*)
  90.  
  91. CONST   DefSize =       12;
  92.  
  93. TYPE    FONT =          POINTER TO Font;
  94.         Font =          RECORD
  95.                          name:   ARRAY [0..32] OF CHAR;  (* Name des Fonts *)
  96.                          id:     sINTEGER;     (* Font-ID *)
  97.                          color:  sINTEGER;     (* Farbindex *)
  98.                          rot:    sINTEGER;     (* Rotationsrichtung *)
  99.                          halign: sINTEGER;     (* Horizontale Ausrichtung *)
  100.                          valign: sINTEGER;     (* Vertikale Ausrichtung *)
  101.                          chw:    sINTEGER;     (* Zeichenbreite *)
  102.                          chh:    sINTEGER;     (* Zeichenh”he *)
  103.                          boxw:   sINTEGER;     (* Zellenbreite *)
  104.                          boxh:   sINTEGER;     (* Zellenh”he *)
  105.                          effect: sBITSET;      (* Texteffekte *)
  106.                          min:    sINTEGER;     (* Minimale Gr”že des Fonts *)
  107.                          max:    sINTEGER;     (* Maximale Gr”že des Fonts *)
  108.                          point:  sINTEGER;     (* aktuelle Gr”že des Fonts *)
  109.                          width:  sINTEGER;     (* Breite bei FSM-Fonts *)
  110.                          skew:   sINTEGER;     (* Neigung bei FSM-Fonts *)
  111.                          mono:   BOOLEAN;      (* TRUE, wenn Monospaced *)
  112.                          fsm:    BOOLEAN;      (* TRUE, wenn FSM-Font *)
  113.                          next:   FONT;         (* Zeiger auf n„chsten Font *)
  114.                         END;
  115.  
  116. TYPE    FONTLIST =      POINTER TO Fontlist;
  117.         Fontlist =      RECORD
  118.                          fonts:  FONT;
  119.                          dummy:  FONT;
  120.                          number: INTEGER;
  121.                         END;
  122.  
  123. (*----------------------------------------------------------------------*)
  124. (*       Die folgenden Deklarationen mssen denen in mtAppl gleichen!   *)
  125. (*----------------------------------------------------------------------*)
  126.  
  127. CONST   cFonts =        0;
  128.         cPhysical =     1;
  129.  
  130. TYPE    WsPtr =         POINTER TO WsInfo;
  131.         WsInfo =        RECORD
  132.                          handle:  sINTEGER;
  133.                          flags:   sBITSET;
  134.                          list:    FONTLIST;
  135.                          next:    WsPtr;
  136.                          last:    WsPtr;
  137.                         END;
  138.  
  139. (*----------------------------------------------------------------------*)
  140.  
  141. VAR     attr:           ARRAY [0..9] OF sINTEGER;
  142.         e1, e2:         ARRAY [0..7] OF sINTEGER;
  143.         gdos:           lCARDINAL;
  144.         errorcode:      sINTEGER;
  145.         fontliste:      FONTLIST;
  146.         p:              WsPtr;
  147.         f, f1:          FONT;
  148.  
  149.  
  150. PROCEDURE GetFont (handle, id: sINTEGER): FONT;
  151. BEGIN
  152.  p:= mtAppl.Intern (handle);
  153.  IF p # NIL THEN
  154.   IF p^.list # NIL THEN
  155.    f:= p^.list^.fonts;
  156.    WHILE f # NIL DO
  157.     IF id = f^.id THEN RETURN f;  END;
  158.     f:= f^.next;
  159.    END; (* WHILE *)
  160.   END;
  161.  END;
  162.  RETURN NIL;
  163. END GetFont;
  164.  
  165. PROCEDURE LoadFonts (handle: sINTEGER): sINTEGER;
  166. VAR i, j, d, c, w, ow, ret: sINTEGER;
  167. BEGIN
  168.  mtAppl.StoreMouse;  mtAppl.MouseBusy;
  169.  errorcode:= 0;
  170.  p:= mtAppl.Intern (handle);
  171.  IF p = NIL THEN
  172.   ret:= ErrWorkstation;
  173.  ELSE
  174.   WITH p^ DO
  175.    IF list # NIL THEN
  176.     ret:= list^.number;
  177.    ELSE
  178.     ALLOCATE (list,  TSIZE (Fontlist));  
  179.     IF list = NIL THEN
  180.      ret:= ErrLessMem;
  181.     ELSE
  182.      list^.dummy:= NIL;
  183.      list^.fonts:= NIL;
  184.      list^.number:= 0;
  185.      WITH list^ DO
  186.       IF gdos = MagicVDI.NoGdos THEN
  187.        number:= 0;
  188.       ELSE
  189.        number:= MagicVDI.LoadFonts (handle, 0);
  190.        INCL (p^.flags, cFonts);
  191.       END;
  192.       f1:= fonts;  i:= 0;
  193.       LOOP
  194.        IF i > number THEN  EXIT;  END;
  195.        ALLOCATE (f,  TSIZE (Font));  
  196.        IF f = NIL THEN
  197.         ret:= ErrLessMem;  EXIT;
  198.        ELSE
  199.         ret:= p^.list^.number;
  200.         f^.fsm:= FALSE;
  201.         f^.id:= InqFacename (handle, i + 1, f^.name, f^.fsm);
  202.         j:= MagicVDI.SetTextface (handle, f^.id);
  203.         MagicVDI.InqText (handle, attr); (* Aktuelle Parameter holen *)
  204.         f^.color:=  attr[1];
  205.         f^.rot:=    attr[2];
  206.         f^.halign:= attr[3];
  207.         f^.valign:= attr[4];
  208.         f^.chw:=    attr[6];
  209.         f^.chh:=    attr[7];
  210.         f^.boxw:=   attr[8];
  211.         f^.boxh:=   attr[9];
  212.         IF f^.fsm THEN
  213.          f^.min:= 1;  f^.max:= MAX (sINTEGER);
  214.         ELSE
  215.          f^.min:= MagicVDI.SetCharpoints (handle, 1, j, j, j, j);
  216.          f^.max:= MagicVDI.SetCharpoints (handle, 9999, j, j, j, j);
  217.         END;
  218.         f^.point:= MagicVDI.SetCharpoints (handle, DefSize, j, j, j, j);
  219.         IF f^.id = 1 THEN (* Sonderbehandlung fr Systemfont *)
  220.          Assign ('Systemfont', f^.name);  (* Name des Fonts *)
  221.          IF CharHeight = 8 THEN  f^.point:= 9;  ELSE  f^.point:= 10;  END;
  222.         END;
  223.         f^.skew:= 0;
  224.         f^.width:= f^.point;
  225.         f^.effect:= {};
  226.         (* Annahme, aber leider gibts keine Abfragem”glichkeit *)
  227.         MagicVDI.InqTextextent (handle, 'MMmmWWww', e1);
  228.         MagicVDI.InqTextextent (handle, 'IIiiLLll', e2);
  229.         j:= 0;  f^.mono:= TRUE;
  230.         WHILE (j < 8) AND f^.mono DO
  231.          f^.mono:= e1[j] = e2[j];  INC (j);
  232.         END;
  233.         f^.next:= NIL;
  234.         IF f1 # NIL THEN  f1^.next:= f;  ELSE  fonts:= f;  END;
  235.         f1:= f;
  236.        END; (* IF f = NIL *)
  237.        INC (i);
  238.       END; (* LOOP *)
  239.       (* Systemfont wieder einstellen *)
  240.       j:= MagicVDI.SetTextface (handle, 1);
  241.       IF CharHeight = 8 THEN  i:= 9;  ELSE  i:= 10;  END;
  242.       j:= MagicVDI.SetCharpoints (handle, i, j, j, j, j);
  243.      END; (* WITH list *)
  244.     END; (* IF list = NIL *)
  245.    END; (* IF list # NIL*)
  246.   END; (* WITH p *)
  247.  END; (* IF p = NIL *)
  248.  mtAppl.RestoreMouse;
  249.  RETURN ret;
  250. END LoadFonts;
  251.  
  252. PROCEDURE UnloadFonts (handle: sINTEGER);
  253. BEGIN
  254.  errorcode:= 0;
  255.  p:= mtAppl.Intern (handle);
  256.  IF p # NIL THEN
  257.   IF p^.list # NIL THEN
  258.    f:= p^.list^.fonts;  f1:= f;
  259.    WHILE f # NIL DO
  260.     DEALLOCATE (f, 0);  ;  f:= f1^.next;  f1:= f;
  261.    END; (* WHILE *)
  262.    DEALLOCATE (p^.list, 0);  ;
  263.   END; (* IF p^.list *)
  264.   EXCL (p^.flags, cFonts);
  265.  END; (* IF p # NIL *)
  266.  MagicVDI.UnloadFonts (handle, 0);
  267. END UnloadFonts;
  268.  
  269. PROCEDURE FontList (handle, flag: sINTEGER): sINTEGER;
  270. VAR x, x2: FONT;
  271. BEGIN
  272.  errorcode:= 0;
  273.  p:= mtAppl.Intern (handle);
  274.  IF p # NIL THEN
  275.   IF p^.list # NIL THEN
  276.    x:= NIL;
  277.    IF p^.list^.dummy = NIL THEN  p^.list^.dummy:= p^.list^.fonts;  END;
  278.    CASE flag OF
  279.     FFIRST:     x:= p^.list^.fonts;
  280.                 |
  281.     FNEXT:      p^.list^.dummy:= p^.list^.dummy^.next;
  282.                 x:= p^.list^.dummy;
  283.                 |
  284.     FPREV:      x:= p^.list^.fonts;
  285.                 WHILE (x # NIL) AND (x^.next # p^.list^.dummy) DO
  286.                  x:= x^.next;
  287.                 END;
  288.                 IF x # NIL THEN  p^.list^.dummy:= x;  END;
  289.                 |
  290.     FLAST:      x2:= p^.list^.fonts;  
  291.                 WHILE (x2 # NIL) DO  x:= x2;  x2:= x2^.next;  END;
  292.                 IF x # NIL THEN  p^.list^.dummy:= x;  END;
  293.                 |
  294.     ELSE        ;
  295.    END; (* CASE *)
  296.   END; (* IF p^.list *)
  297.  END; (* IF p # NIL *)
  298.  IF x = NIL THEN  RETURN 0;  ELSE  RETURN x^.id;  END;
  299. END FontList;
  300.  
  301. PROCEDURE FontInfo (handle, font: sINTEGER; VAR info: tFontinfo);
  302. BEGIN
  303.  errorcode:= 0;
  304.  f:= GetFont (handle, font);
  305.  IF f # NIL THEN
  306.   Assign (f^.name, info.name);
  307.   info.id:=     f^.id;
  308.   info.color:=  f^.color;
  309.   info.rot:=    f^.rot;
  310.   info.halign:= f^.halign;
  311.   info.valign:= f^.valign;
  312.   info.chw:=    f^.chw;
  313.   info.chh:=    f^.chh;
  314.   info.boxw:=   f^.boxw;
  315.   info.boxh:=   f^.boxh;
  316.   info.effect:= f^.effect;
  317.   info.min:=    f^.min;
  318.   info.max:=    f^.max;
  319.   info.point:=  f^.point;
  320.   info.width:=  f^.width;
  321.   info.skew:=   f^.skew;
  322.   info.mono:=   f^.mono;
  323.   info.fsm:=    f^.fsm;
  324.  ELSE (* Keine Fonts geladen *)
  325.   MagicVDI.InqText (handle, attr);
  326.   info.id:= attr[0];
  327.   IF info.id = 1 THEN  Assign ('Systemfont', info.name);
  328.                  ELSE  Assign ('', info.name);
  329.   END;
  330.   info.color:=  attr[1];
  331.   info.rot:=    attr[2];
  332.   info.halign:= attr[3];
  333.   info.valign:= attr[4];
  334.   info.chw:=    attr[6];
  335.   info.chh:=    attr[7];
  336.   info.boxw:=   attr[8];
  337.   info.boxh:=   attr[9];
  338.   info.min:=    -1;
  339.   info.max:=    -1;
  340.   info.width:=  -1;
  341.   info.skew:=   -1;
  342.   info.fsm:=    FALSE;
  343.   IF info.id = 1 THEN
  344.    IF CharHeight = 8 THEN  info.point:= 9;  ELSE  info.point:= 10;  END;
  345.   END;
  346.   info.mono:= TRUE;
  347.  END; (* IF list *)
  348. END FontInfo;
  349.  
  350. PROCEDURE FontActive (handle: sINTEGER): sINTEGER;
  351. BEGIN
  352.  errorcode:= 0;
  353.  MagicVDI.InqText (handle, attr);
  354.  f:= GetFont (handle, attr[0]);
  355.  IF f # NIL THEN (* Bei der Gelgenheit gleichmal unsere Daten auffrischen *)
  356.   f^.color:= attr[1];
  357.   f^.rot:= attr[2];
  358.   f^.halign:= attr[3];
  359.   f^.valign:= attr[4];
  360.   f^.chw:= attr[6];
  361.   f^.chh:= attr[7];
  362.   f^.boxw:= attr[8];
  363.   f^.boxh:= attr[9];
  364.  END;
  365.  RETURN attr[0];
  366. END FontActive;
  367.  
  368. PROCEDURE FontSelect (handle: sINTEGER; font: sINTEGER; actual: BOOLEAN);
  369. VAR i, p, w, s, r, c: sINTEGER;  e: sBITSET;
  370. BEGIN
  371.  errorcode:= 0;
  372.  IF actual THEN  f:= GetFont (handle, FontActive (handle));
  373.            ELSE  f:= GetFont (handle, font);
  374.  END;
  375.  IF f # NIL THEN
  376.   p:= f^.point;  w:= f^.width;  s:= f^.skew;
  377.   r:= f^.rot;  c:= f^.color;  e:= f^.effect;
  378.   IF actual THEN  f:= GetFont (handle, font);  END;
  379.   IF f # NIL THEN
  380.    i:= MagicVDI.SetTextface (handle, font);
  381.    IF f^.fsm THEN
  382.     f^.point:= SetArbpoints (handle, p, i, i, i, i);
  383.     f^.width:= SetSize (handle, w, i, i, i, i);
  384.     f^.skew:= SetSkew (handle, s);
  385.    ELSE
  386.     f^.point:= MagicVDI.SetCharpoints (handle, p, i, i, i, i);
  387.    END;
  388.    f^.rot:= MagicVDI.SetCharbaseline (handle, r);
  389.    f^.color:= MagicVDI.SetTextcolor (handle, c);
  390.    f^.effect:= MagicVDI.SetTexteffect (handle, e);
  391.   ELSE
  392.    errorcode:= -1;
  393.   END;
  394.   i:= FontActive (handle);
  395.  ELSE
  396.   errorcode:= -1;
  397.  END;
  398. END FontSelect;
  399.  
  400. PROCEDURE FontSize (handle: sINTEGER; point: sINTEGER;
  401.                     VAR chw, chh, boxw, boxh: sINTEGER): sINTEGER;
  402. VAR i: sINTEGER;
  403. BEGIN
  404.  errorcode:= 0;
  405.  f:= GetFont (handle, FontActive (handle));
  406.  IF f # NIL THEN
  407.   IF f^.fsm THEN
  408.    f^.point:= SetArbpoints (handle, point, chw, chh, boxw, boxh);
  409.    f^.width:= SetSize (handle, f^.width, i, i, i, i);
  410.    f^.skew:= SetSkew (handle, f^.skew);
  411.   ELSE
  412.    f^.point:= MagicVDI.SetCharpoints (handle, point, chw, chh, boxw, boxh);
  413.   END;
  414.   i:= FontActive (handle);
  415.   RETURN f^.point;
  416.  ELSE
  417.   errorcode:= -1;
  418.  END;
  419.  RETURN errorcode;
  420. END FontSize;
  421.  
  422. PROCEDURE FontDefsize (handle: INTEGER): INTEGER;
  423. VAR i, j: sINTEGER;
  424. BEGIN
  425.  errorcode:= 0;
  426.  f:= GetFont (handle, FontActive (handle));
  427.  IF f # NIL THEN
  428.   IF f^.id = 1 THEN
  429.    IF CharHeight = 8 THEN  i:= 9;  ELSE  i:= 10;  END;
  430.   ELSIF f^.fsm THEN
  431.    i:= DefSize;
  432.   ELSE
  433.    i:= f^.max DIV 2;
  434.   END;
  435.   f^.point:= MagicVDI.SetCharpoints (handle, i, j, j, j, j);
  436.   i:= FontActive (handle);
  437.   RETURN f^.point;
  438.  ELSE
  439.   errorcode:= -1; 
  440.  END;
  441.  RETURN errorcode;
  442. END FontDefsize;
  443.  
  444. PROCEDURE NextSize (handle: INTEGER; bigger: BOOLEAN): INTEGER;
  445. VAR act, size, new, i: INTEGER;
  446.     ende: BOOLEAN;
  447. BEGIN
  448.  errorcode:= 0;
  449.  f:= GetFont (handle, FontActive (handle));
  450.  IF f # NIL THEN
  451.   new:= f^.point;  act:= f^.point;
  452.   IF bigger THEN  ende:= f^.point >= f^.max;
  453.             ELSE  ende:= f^.point <= f^.min;
  454.   END;
  455.   WHILE (f^.point = act) AND (NOT ende) DO
  456.    IF bigger THEN  INC (new);  ende:= f^.point >= f^.max;
  457.              ELSE  DEC (new);  ende:= f^.point <= f^.min;
  458.    END;
  459.    IF f^.fsm THEN
  460.     f^.point:= SetArbpoints (handle, new, i, i, i, i);
  461.     f^.width:= SetSize (handle, f^.width, i, i, i, i);
  462.     f^.skew:= SetSkew (handle, f^.skew);
  463.    ELSE
  464.     f^.point:= MagicVDI.SetCharpoints (handle, new, i, i, i, i);
  465.    END;
  466.   END;
  467.   i:= FontActive (handle);
  468.   RETURN f^.point;
  469.  ELSE
  470.   errorcode:= -1;
  471.  END;
  472.  RETURN errorcode;
  473. END NextSize;
  474.  
  475. PROCEDURE NextBigger (handle: INTEGER): INTEGER;
  476. BEGIN
  477.  RETURN NextSize (handle, TRUE);
  478. END NextBigger;
  479.  
  480. PROCEDURE NextSmaller (handle: INTEGER): INTEGER;
  481. BEGIN
  482.  RETURN NextSize (handle, FALSE);
  483. END NextSmaller;
  484.  
  485. PROCEDURE FontColor (handle, color: sINTEGER);
  486. BEGIN
  487.  errorcode:= 0;
  488.  f:= GetFont (handle, FontActive (handle));
  489.  IF f # NIL THEN
  490.   f^.color:= MagicVDI.SetTextcolor (handle, color);
  491.  ELSE
  492.   errorcode:= -1;
  493.  END;
  494. END FontColor;
  495.  
  496. PROCEDURE FontEffekt (handle: sINTEGER; effekt: sBITSET);
  497. BEGIN
  498.  errorcode:= 0;
  499.  f:= GetFont (handle, FontActive (handle));
  500.  IF f # NIL THEN
  501.   f^.effect:= MagicVDI.SetTexteffect (handle, effekt);
  502.  ELSE
  503.   errorcode:= -1;
  504.  END;
  505. END FontEffekt;
  506.  
  507. PROCEDURE FontRotate (handle, angle: sINTEGER): sINTEGER;
  508. BEGIN
  509.  errorcode:= 0;
  510.  f:= GetFont (handle, FontActive (handle));
  511.  IF f # NIL THEN
  512.   f^.rot:= MagicVDI.SetCharbaseline (handle, angle);
  513.   RETURN f^.rot;
  514.  ELSE
  515.   errorcode:= -1;
  516.  END;
  517.  RETURN errorcode;
  518. END FontRotate;
  519.  
  520. PROCEDURE FontWidth (handle, width: sINTEGER);
  521. VAR i: sINTEGER;
  522. BEGIN
  523.  errorcode:= 0;
  524.  f:= GetFont (handle, FontActive (handle));
  525.  IF f # NIL THEN
  526.   IF f^.fsm THEN  f^.width:= SetSize (handle, width, i, i, i, i);  END;
  527.  ELSE
  528.   errorcode:= -1;
  529.  END;
  530. END FontWidth;
  531.  
  532. PROCEDURE FontSkew (handle: sINTEGER; skew: sINTEGER);
  533. BEGIN
  534.  errorcode:= 0;
  535.  f:= GetFont (handle, FontActive (handle));
  536.  IF f # NIL THEN
  537.   IF f^.fsm THEN  f^.skew:= SetSkew (handle, skew);  END;
  538.  ELSE
  539.   errorcode:= -1;
  540.  END;
  541. END FontSkew;
  542.  
  543. PROCEDURE FontExtent (handle: sINTEGER; REF str: ARRAY OF CHAR;
  544.                       VAR rect: ARRAY OF LOC);
  545. BEGIN
  546.  errorcode:= 0;
  547.  f:= GetFont (handle, FontActive (handle));
  548.  IF f # NIL THEN
  549.   IF f^.fsm THEN  InqFExtent (handle, str, rect);
  550.             ELSE  MagicVDI.InqTextextent (handle, str, rect)
  551.   END;
  552.  ELSE
  553.   errorcode:= -1;
  554.  END;
  555. END FontExtent;
  556.  
  557. PROCEDURE FontError (): sINTEGER;
  558. BEGIN
  559.  RETURN errorcode;
  560. END FontError;
  561.  
  562. BEGIN
  563.  gdos:= VqGdos();
  564.  IF gdos = FSMGdos THEN
  565.   SetErrormode (VDIHandle, ToApplication, errorcode);
  566.  END;
  567. END mtFonts.
  568.